Datos agrupados

class: center, middle, inverse, title-slide

# Datos agrupados
## actuar
### Yanely Luna Gutiérrez
### Facultad de Ciencias, UNAM
### 2021/03/23 (updated: 2021-05-08)

---

# ¿Qué son los datos agrupados?

Llamamos **datos agrupados** a aquellos que se presentan en forma de **frecuencia por intervalo**. Esto quiere decir que en vez de tener los valores exactos de las observaciones tenemos solo el intervalo al que pertenecen. Es común trabajar con este tipo de datos en análisis de supervivencia (con observaciones por intervalos de tiempo) pero también pueden presentarse en datos sobre severidad y frecuencia de reclamaciones de seguros.

---

.pull-left[

Table: Ejemplo de datos agrupados para la frecuencia de siniestros.

| Number_accidents | Number_drivers |
|:----------------:|:--------------:|
|        0         |     81714      |
|        1         |     11306      |
|        2         |      1618      |
|        3         |      250       |
|        4         |       40       |
|     5 o más      |       7        |
]

.pull-right[
En el ejemplo de la [Tabla 1](#frecuencia_agrup), el número de conductores está agrupado por el número de accidentes que tuvieron en un año (250 conductores tuvieron 3 accidentes cada uno en un año). En este caso, no conocemos el número exacto de accidentes de los 7 conductores que pertenecen al último renglón, solo sabemos que tuvieron 5 o más accidentes.
]

---

.pull-left[

Table: Ejemplo de datos agrupados para la severidad.

|  Payment_range  | Number_payments |
|:---------------:|:---------------:|
|     0-7,500     |       99        |
|  7,500-17,500   |       42        |
|  17,500-32,500  |       29        |
|  32,500-67,500  |       28        |
| 67,500-125,000  |       17        |
| 125,000-300,000 |        9        |
|  Over 300,000   |        3        |
]

.pull-right[
En el ejemplo de la [Tabla 2](#severidad_agrup) no conocemos el monto exacto de cada reclamación pero sí el intervalo al que pertenecen (tenemos 17 reclamaciones cuyo monto es mayor a 67,500 y menor a 125,000).
]
---
# Objeto `grouped.data` en `actuar`

```r
#install.packages("actuar")
library(actuar)
```

La paquetería `actuar` provee funciones enfocadas en la modelación de variables de pérdida y otros temas relacionados que añaden funcionalidad en materia actuarial a `R`. Los principales temas que cubre esta paquetería son: modelación de variables de pérdida, teoría del riesgo (y de la ruina), simulación de modelos jerárquicos compuestos y teoría de la credibilidad.

En particular, esta paquetería provee una forma sencilla de almacenar, manipular y obtener estadísticas de datos agrupados. Dado que hay muchas formas de almacenar este tipo de datos, `actuar` cuenta con una forma estandarizada de hacerlo, creando objetos tipo `grouped.data` con la función homónima.

---
## Para crear un objeto `grouped.data`:

+ La función `grouped.data` recibe el vector que contiene los extremos de los intervalos a crear (en el ejemplo llamamos `Grupo` a este vector, pero se le puede poner cualquier nombre válido).

+ Después de pasar el vector para los intervalos, pasamos el o los vectores que representan la frecuencia, asignando al nombre que corresponda (cualquier nombre válido).

```r
gd <- grouped.data(Grupo=c(0,25,50,100,150,250,500), 
                   Frecuencia_1=c(30, 31, 57, 42, 45,10), 
                   Frecuencia_2=c(81,40,33,12,7,26))
gd
```

```
       Grupo Frecuencia_1 Frecuencia_2
1   (0,  25]           30           81
2  (25,  50]           31           40
3  (50, 100]           57           33
4 (100, 150]           42           12
5 (150, 250]           45            7
6 (250, 500]           10           26
```

---

El objeto creado (`gd`) es a la vez un `data.frame` y un `grouped.data`, por lo que se pueden aplicar las funciones para extraer y sustituir columnas y renglones como a un `data.frame`. Es importante notar que la columna que representa los intervalos puede extraerse para ser manejada como un vector numérico, aunque dentro del objeto se considera como una columna de caracteres.

```r
#Columna tipo character
gd$Grupo
```

```
[1] "(0,  25]"   "(25,  50]"  "(50, 100]"  "(100, 150]" "(150, 250]"
[6] "(250, 500]"
```

```r
class(gd$Grupo)
```

```
[1] "character"
```

```r
#Vector numérico
gd[,1]
```

```
[1]   0  25  50 100 150 250 500
```

```r
class(gd[,1])
```

```
[1] "numeric"
```

---
# Crear un histograma

El objeto `grouped.data` cuenta con un método para crear un histograma respetando los intervalos proporcionados, por lo que solo tenemos que usar la función `hist()` y pasarle el objeto `grouped.data` con los datos de frecuencia que queremos graficar.

```r
#Histograma de Frecuencia_1
hist(gd[,-3],col="lightblue",main="Frecuencia_1",xlab="Grupos")
```

---

# Ojiva

Denotamos como `$c_0 < c_1 <\cdots < c_k$` los puntos que definen los intervalos de nuestro datos agrupados (usualmente `$c_0=0$` y `$c_k=\infty$`) y `$n_j$` como el número de observaciones que pertenecen al intervalo `$(c_{j-1},c_j]$` (con excepción del primer intervalo, el cual es `$[c_0,c_1]$`); donde `$\sum_{j=1}^k n_j = n$` es el total de observaciones.

Para datos agrupados podemos calcular la función de distribución empírica en los extemos de cada intervalo como el número de observaciones acumuladas hasta dicho extremo entre el total de observaciones, es decir `$$F_n(c_j) = \frac{1}{n}\sum_{i=1}^j n_i$$`

Una manera de aproximar la función de distribución de los datos agrupados es conectar mediante una línea recta los puntos de `$F_n$` que obtuvimos en los extremos de los intervalos. La función de distribución que se obtiene con este método es llamada **ojiva** y queda definida como:
`$$F_n(x)=\frac{c_j-x}{c_j-c_{j-1}}F_n(c_{j-1})+\frac{x-c_{j-1}}{c_j-c_{j-1}}F_n(c_j)$$` 
para `$c_{j-1}\leq x \leq c_j$`, `$F_n(x)=0$` si `$x<c_0$` y `$F_n(x)=1$` si `$x>c_k$`.

---

`actuar` cuenta con la función `ogive()` para obtener dicha función de distribución.

```r
#Creamos Fn (una función)
Fn <- ogive(gd)
```

```r
#Para obtener los extremos de los intervalos
knots(Fn)
```

```
[1]   0  25  50 100 150 250 500
```
--

```r
#Valores de la ojiva en dichos extremos
Fn(knots(Fn))
```

```
[1] 0.0000000 0.1395349 0.2837209 0.5488372 0.7441860 0.9534884 1.0000000
```
---

```r
#Gráfica de la función
plot(Fn)
```

Usando `ggplot2`:
---
count: false

.panel1-ojiva-auto[

```r
*Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))
```
]
 
.panel2-ojiva-auto[

]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

*Fn_df
```
]
 
.panel2-ojiva-auto[

```
    x         y
1   0 0.0000000
2  25 0.1395349
3  50 0.2837209
4 100 0.5488372
5 150 0.7441860
6 250 0.9534884
7 500 1.0000000
```
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
*ggplot()
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_03_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
* aes(x=x,y=y)
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_04_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
  aes(x=x,y=y) +
* geom_point(col='slateblue',size=2)
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_05_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
  aes(x=x,y=y) +
  geom_point(col='slateblue',size=2) +
* geom_line(col='skyblue2',size=1.2)
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_06_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
  aes(x=x,y=y) +
  geom_point(col='slateblue',size=2) +
  geom_line(col='skyblue2',size=1.2) +
* ylab("Fn(x)")
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_07_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
  aes(x=x,y=y) +
  geom_point(col='slateblue',size=2) +
  geom_line(col='skyblue2',size=1.2) +
  ylab("Fn(x)") +
* ggtitle("ogive")
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_08_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
  aes(x=x,y=y) +
  geom_point(col='slateblue',size=2) +
  geom_line(col='skyblue2',size=1.2) +
  ylab("Fn(x)") +
  ggtitle("ogive")+
* theme_minimal()
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_09_output-1.png" style="display: block; margin: auto;" />
]

---
count: false

.panel1-ojiva-auto[

```r
Fn_df <- data.frame(x=knots(Fn),y=Fn(knots(Fn)))

Fn_df %>%
ggplot() +
  aes(x=x,y=y) +
  geom_point(col='slateblue',size=2) +
  geom_line(col='skyblue2',size=1.2) +
  ylab("Fn(x)") +
  ggtitle("ogive")+
  theme_minimal() +
* theme(plot.title = element_text(size=15, face="bold",
*   margin = margin(10, 0, 10, 0),family = "mono"))
```
]
 
.panel2-ojiva-auto[
<img src="index_files/figure-html/ojiva_auto_10_output-1.png" style="display: block; margin: auto;" />
]

---

# Cálculo de momentos empíricos

El paquete `actuar` tiene implementada la función `mean()` para datos agrupados, la cual calcula el primer momento empírico con la siguiente fórmula `$$\frac{1}{n}\sum_{j=1}^r \left(\frac{c_{j-1}+c_j}{2}\right)n_j$$`

```r
#Cálculo de la media
mean(gd)
```

```
Frecuencia_1 Frecuencia_2 
   110.75581     88.63065 
```

---
Para calcular momentos empíricos de mayor orden, `actuar` proporciona la función `emm()`, la cual calcula el k-ésimo momento empírico para datos agrupados siguiendo la fórmula:

`$$\sum_{j=1}^r \frac{n_j*(c_j^{k+1} - c_{j-1}^{k+1})}{n*(k+1)*(c_j - c_{j-1})}$$`

```r
#Cálculo de los primeros tres momentos empíricos
emm(gd,order=1:3)
```

```
                  [,1]     [,2]    [,3]
Frecuencia_1 110.75581 20208.33 5034430
Frecuencia_2  88.63065 22789.99 8168047
```

---
Además, `actuar` tiene implementada la función `elev()` (_empirical limited expected value_) para el cálculo del primer momento empírico limitado para cualquier límite `$d>0$`, es decir, calcula el valor observado de `$$E(X\wedge d)$$`.

Similar a la función `ogive()`, con `elev()` creamos una función a la cual le pasamos el límite `$d$` y calcula el valor esperado empírico con éste límite.

```r
#Creamos la función lev
lev <- elev(gd)
```
--

```r
#Extremos de los intervalos
knots(lev)
```

```
[1]   0  25  50 100 150 250 500
```
--

```r
#Valor de la función en los extremos de los intervalos
lev(knots(lev))
```

```
[1]   0.00000  23.25581  42.96512  72.15116  89.82558 104.94186 110.75581
```
---

```r
#Al graficar la función, se grafican de manera determinada sus valores en los extremos de los intervalos
plot(lev,pch=19)
```

Usando `ggplot2:`

---

count: false

.panel1-elev-auto[

```r
*d <- seq(0,500,by=25)
```
]
 
.panel2-elev-auto[

]

---
count: false

.panel1-elev-auto[

```r
d <- seq(0,500,by=25)
*df <- data.frame(x=d,y=lev(d))
```
]
 
.panel2-elev-auto[

]

---
count: false

.panel1-elev-auto[